perm filename PROTX[E,ALS] blob
sn#189269 filedate 1975-12-04 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 Code to report protection and to allow it to be changed.
C00005 ENDMK
Cā;
;Code to report protection and to allow it to be changed.
PROTEC: SETZM PROTEF# ;Used as flag and to hold A value
MOVE T,EXTPNT ;Data already gobbled into EXTBUF by EXTEND
MOVEM T,TYIPNT
HRLI C,(<MOVEI C,>)
MOVEM C,TYIINS
PUSHJ P,TYI
JRST PROTE4 ;Report only
TRNE F,REDNLY
JRST PROTE2 ;Do not change if in readonly
MOVEI A,0
MOVEI B,3
SETOM PROTEF ;Anticipate change
PROTE0: CAIG C,71
CAIGE C,60
SETZM PROTEF ;No, can not change after all
LSH A,3
ADDI A,-"0"(C)
PUSHJ P,TYI
JRST PROTE4 ;Last character found
SOJG B,PROTE0
SETZM PROTEF ;Too many characters so ignore
PROTE1: OUTSTR [ASCIZ / Only 3 octal digits allowed. /]
JRST PROTE4
PROTE2: OUTSTR [ASCIZ / Cannot be changed in READONLY mode. /]
SETZM PROTEF
JRST PROTE4
PROTE3: OUTSTR [ASCIZ / Rename failure /]
DPB T,[331100,,EDFIL+2] ;Restore old valuee
HRRZ T,EDFIL+1
MOVE A,[440700,,C]
PUSHJ P,OCTSTR
OUTSTR C
MOVEI E,EDFIL
PUSHJ P,OPENW ;Rename failure closes this file
JRST PROTEX
PROTE4: SKIPE PROTEF
MOVEM A,PROTEF ;Save value temporarily
OUTSTR [ASCIZ /
Protection key /]
SETZM TYOPNT
LDB T,[331100,,EDFIL+2]
PUSHJ P,OCT3ST
OUTSTR C
TYPCHR " "
SKIPN A,PROTEF
JRST PROTEX
HLLZS EDFIL+1
LDB T,[331100,,EDFIL+2] ;Save for rename failure situation
SETZM EDFIL+2
SKIPN EDFIL
JRST PROTE3 ;To prevent deletion if bug exists
DPB A,[331100,,EDFIL+2]
RENAME DSKO,EDFIL
JRST PROTE3 ;Something is wrong
OUTSTR [ASCIZ / changed to /]
LDB T,[331100,,EDFIL+2]
PUSHJ P,OCT3ST
OUTSTR C
PROTEX: SETZM TYIPNT
JRST PPJ1CR